﻿Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports System
Imports System.Drawing
Imports System.Drawing.Imaging


Public Class Grafikengine
#Region "Variablen"
    Public Const Backgroundentfernung As Single = 0.999
    Public Const _Kamera_NaehesteZiel As Single = 0.1
    Public Const _Kamera_WeitesteZiel As Integer = 10000
    Const FeldDistanz As Single = -1.5
    'Sprite Objekt
    ''' <summary>
    ''' Die Sprites werden von hier in den Backpuffer gezeichnet
    ''' </summary>
    Public Shared Sprite As Direct3D.Sprite
    'Hier stehen Texturen
    ''' <summary>
    ''' Textur Ausschnitt
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared recBild As Drawing.Rectangle
    ''' <summary>
    ''' Skalierung
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared szfScale As Drawing.Size
    ''' <summary>
    ''' Rotatationszentrum 0,0 ist die obere Ecke des Bildes 
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared ptfRotCenter As Drawing.Point
    ''' <summary>
    ''' Position von der aus gezeichnet wird
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared ptfPosition As Drawing.Point


    ''' <summary>
    ''' Der Device stellt die Grafikkarte dar
    ''' </summary>
    ''' 
    Public Shared Grafikkarte As Device = Nothing
    ''' <summary>
    ''' Parameter der Grafikkarte.
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared _presentParameter As PresentParameters
    ''' <summary>
    ''' Der Boolen der angibt ob wir alles in ein Fenster zeichnen
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared IneinemFenster As Boolean = False
    Public Shared SCREENWIDTH As Single = 800
    Public Shared SCREENHEIGHT As Single = 600
    Public Shared Verwalter As Objektverwalter
    Public Shared PI As Single
    Private Shared FilledTexture As Texture
    ''' <summary>
    ''' If true haben wir den Device verloren
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared DeviceLost As Boolean = False

    Public Shared Lichtfarbe As Color = Color.White
    Shared Ambientfarbe As Color = Color.FromArgb(0, 50, 50, 50)
    ''' <summary>
    ''' Das weiteste Ziel der Kamera
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared WeitestesZiel As Single = 40
#End Region

#Region "Laden"
    ''' <summary>
    ''' Gibt unserer Grafikkarte die passende aufloesung
    ''' </summary>
    ''' <param name="Breite">Die Breite des Bildschirms(800,1024,1280)</param>
    ''' <param name="Hoehe">Die Hoehe des Bildschrims(600,768,800)</param>
    ''' <param name="InFensterrendern">Sagt ob das Bild in einem Fenster oder auf dem Bildschirm gezeichnet wird</param>
    ''' <param name="adap">Der Adapter (welcher Bildschirm)</param>
    Public Sub New(ByVal Breite As Integer, ByVal Hoehe As Integer, ByVal HM As Control, ByVal InFensterrendern As Boolean, Optional ByVal adap As Integer = 0)
        'Hier werden Konstanten festgelegt
        SetPI()
        SCREENWIDTH = Breite
        SCREENHEIGHT = Hoehe
        IneinemFenster = InFensterrendern
        'DirectX initialisieren
        If Initialization(HM, adap) = False Then
            MessageBox.ShowMessageBox("DirectX couldn't be initialized. Try to reset the settings. (Click at ""help!"" at the CommanderWars launcher", MsgBoxStyle.Critical, "Fatal Error!")
        End If


        'Direct3D Font Objekt erzeugen
        IniToolsAnd2D()
    End Sub
    Public Shared Sub NeuLaden(ByVal Breite As Integer, ByVal Hoehe As Integer, ByVal HM As Control, ByVal InFensterrendern As Boolean)
        'Hier werden Konstanten festgelegt
        SetPI()
        SCREENWIDTH = Breite
        SCREENHEIGHT = Hoehe
        IneinemFenster = InFensterrendern
        'DirectX initialisieren
        If Initialization(HM) = False Then

        End If
        'Direct3D Font Objekt erzeugen

        'Texture laden

        'If LoadTexture() = False Then
        '    MessageBox.Show("Die Texture konnte nicht geladen werden. Das Beispiel wird beendet.")
        '    Return False
        'End If
    End Sub
    ''' <summary>
    ''' Inizialisiert die Grafikengine. Wird von New() aufgerufen
    ''' </summary>
    ''' <param name="HM"></param>
    ''' <param name="adap">Der Adapter (welcher Bildschirm)</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Shared Function Initialization(ByVal HM As Control, Optional ByVal adap As Integer = 0) As Boolean

        _presentParameter = CreatePresentParameters(adap)
        'Device erstellen falls keiner vorhanden...
        'Manager.Adapters.Item(0)
        If Grafikkarte Is Nothing Then
            Dim D3DCaps As Caps = Manager.GetDeviceCaps(adap, DeviceType.Hardware)
            Dim CreateFlgs As CreateFlags
            If D3DCaps.DeviceCaps.SupportsHardwareTransformAndLight() And _
            D3DCaps.DeviceCaps.SupportsPureDevice Then
                CreateFlgs = CreateFlags.HardwareVertexProcessing Or _
                  CreateFlags.PureDevice
            ElseIf D3DCaps.DeviceCaps.SupportsHardwareTransformAndLight() Then
                CreateFlgs = CreateFlags.HardwareVertexProcessing
            Else
                CreateFlgs = CreateFlags.SoftwareVertexProcessing
            End If
            CreateFlgs = CreateFlgs Or CreateFlags.MultiThreaded


            Try
                Grafikkarte = New Device(adap, DeviceType.Hardware, HM, CreateFlgs, _presentParameter)
            Catch dxerr As DirectXException
                Konsole.Write("Unable to create Device: " + dxerr.ToString)
                Return False
            Catch
                Konsole.Write("Unable to create Device. Unknown problem.")
                Return False
            End Try 'CreateFlags.SoftwareVertexProcessing

        End If
        'Sprite Objekt erstellen
        Sprite = New Direct3D.Sprite(Grafikkarte)
        Schriftengine.MeasureSprite = New Direct3D.Sprite(Grafikkarte)
        ' Grafikkarte.RenderState.ZBufferEnable = True
        InitDeviceValues()

        Dim M As New Material
        'M.Ambient = Color.White
        M.Emissive = Color.White
        ' M.Diffuse = Color.White
        Mat = M
        'die kleine Box, zur Intersection..
        Box = Mesh.Box(Grafikkarte, 1, 0.001, 1)

        Grafikkarte.Transform.Projection = Matrix.PerspectiveFovLH(Math.PI / 4, DataSettings.BildschirmBreite / DataSettings.BildschirmHoehe, _Kamera_NaehesteZiel, _Kamera_WeitesteZiel)
        Return True
    End Function
    Public Shared Sub InitDeviceValues()
        GetStartDeviceValues()


        'Transparenz im 3D
        'Alpha Blend Ja Nein?
        Grafikkarte.RenderState.AlphaBlendEnable = True
        'Welcher Alpha-Wert soll genommen werden
        Grafikengine.Grafikkarte.RenderState.SourceBlend = Blend.BothSourceAlpha
        'Mit dem Invertierten vom Source Blend muss DestinationBlend gemalt werden.
        Grafikengine.Grafikkarte.RenderState.DestinationBlend = Blend.BothInvSourceAlpha
        'Soll die Transparenz Vergleichs Funktion verwendet werden?
        Grafikengine.Grafikkarte.RenderState.AlphaTestEnable = True
        'Vergleich der beiden Alpha-Werte nur wenn Alpha-Test=true
        Grafikengine.Grafikkarte.RenderState.AlphaFunction = Compare.Greater

        If DataSettings._2D_3D_Malen Then
            'Soll die Transparenz Vergleichs Funktion verwendet werden?
            Grafikengine.Grafikkarte.RenderState.AlphaTestEnable = True
            Grafikengine.Grafikkarte.RenderState.Lighting = False
            With Grafikkarte.RenderState
                .Lighting = False
                .FillMode = FillMode.Solid
                .ZBufferEnable = True
                .AntiAliasedLineEnable = True
                .MultiSampleAntiAlias = True
                .DitherEnable = True
                .NormalizeNormals = True
                .SpecularEnable = True
                .ShadeMode = ShadeMode.Gouraud
            End With
        End If
        If DataSettings.draw3D Then
            Grafikengine.Grafikkarte.RenderState.Lighting = True
            'Noch ein paar 3D sachen
            With Grafikkarte.RenderState
                .Lighting = True
                .FillMode = FillMode.Solid
                .ZBufferEnable = True
                .AntiAliasedLineEnable = True
                .MultiSampleAntiAlias = True
                .DitherEnable = True
                .NormalizeNormals = True
                .SpecularEnable = True
                .ShadeMode = ShadeMode.Gouraud

                ''Nebel machen...
                '.FogStart = 20
                '.FogEnd = 200
                '.FogColor = Color.Lime
                '.FogTableMode = FogMode.Linear
                '.FogEnable = Nebel
            End With
            'ein paar Irrlichter...
            Grafikkarte.Lights(0).Type = LightType.Directional
            Grafikkarte.Lights(0).Position = New Vector3(0, 0, 0)
            Grafikkarte.Lights(0).Direction = New Vector3(0, -1, 0.1)
            Grafikkarte.Lights(0).Diffuse = Lichtfarbe
            Grafikkarte.Lights(0).Ambient = Ambientfarbe
            Grafikkarte.Lights(0).Attenuation0 = 0.2
            Grafikkarte.Lights(0).Range = 1000
            Grafikkarte.Lights(0).Enabled = True

            Grafikkarte.Lights(0).Update()

            Grafikkarte.Lights(1).Ambient = Color.White
            Grafikkarte.Lights(1).Type = LightType.Point
            'Noch zu den Lichtern, alles was ich weiss, oder zu wissen glaube...
            'Ambient: Ein Licht das generell, ueberall und egal wo ist. (reflektiertes licht; also einfach, dass nicht alles schwarz ist, sondern dass es eben einfach zusaetzlich etwas licht gibt.
            'Ambient Color

            'Directional: Naja, im Grunde wie ambient, nur dass es hier auf die richtung ankommt.
            'Type
            'Diffuse
            'Range
            'Direction
        End If
    End Sub
    Public Shared Sub ChangeScreenResolution(ByVal Width As Integer, ByVal Height As Integer, ByVal Depth As Integer)
        If Not DataSettings.Fenstermodus Then
            Width = My.Computer.Screen.Bounds.Width
            Height = My.Computer.Screen.Bounds.Height
        End If
        'Change Screen Resolution
        Grafikkarte.PresentationParameters.BackBufferWidth = Width
        Grafikkarte.PresentationParameters.BackBufferHeight = Height
        Select Case Depth
            Case 16
                Grafikkarte.PresentationParameters.BackBufferFormat = Format.R5G6B5
            Case 32
                Grafikkarte.PresentationParameters.BackBufferFormat = Format.X8R8G8B8
        End Select
        DataSettings.BildschirmBreite = Width
        DataSettings.BildschirmHoehe = Height
        DataSettings.MySettingsIniSave()
        Hauptmenue.MainMenue.Size = New Size(Width + Hauptmenue.Rand.X * 2, Height + Hauptmenue.Rand.Y + Hauptmenue.Rand.X)
        Grafikengine.ResetDevice()
    End Sub
    Public Shared Function GetCurrentColorDepth() As Integer
        Select Case Grafikkarte.PresentationParameters.BackBufferFormat
            Case Format.X8R8G8B8
                Return 32
            Case Else
                Return 16
        End Select
    End Function
    Private Shared Sub GetStartDeviceValues()
        Grafikkarte.RenderState.AlphaBlendEnable = False
        Grafikkarte.RenderState.SourceBlend = Blend.One
        Grafikkarte.RenderState.DestinationBlend = Blend.Zero
        With Grafikkarte.RenderState
            .Lighting = True
            .FillMode = FillMode.Solid
            .ZBufferEnable = True
            .AntiAliasedLineEnable = False
            .MultiSampleAntiAlias = True
            .DitherEnable = False
            .NormalizeNormals = False
            .SpecularEnable = False
            .ShadeMode = ShadeMode.Gouraud
        End With
        Grafikkarte.Lights.Reset()
    End Sub
    ''' <summary>
    ''' Creates 2D Stuff and other Tools.
    ''' </summary>
    ''' <remarks></remarks>
    Shared Sub IniToolsAnd2D()
        'Zufallsgenerator starten
        Randomize()
        Zufall = New Random()
        Konsole.TextInput = New TextBox
        Konsole.TextInput.Name = "TextInput"
        Konsole.TextInput.Top = -400
        Hauptmenue.MainMenue.Controls.Add(Konsole.TextInput)
        Hauptmenue.TextInput = Konsole.TextInput
        Objekt2D.InputTextBox = Konsole.TextInput
        Konsole.Konsolenschrift = Schriftengine.CreateSchriftart(Schriftengine.Schriftarten.Courier_New, 10, FontStyle.Italic)
        FilledTexture = Grafikengine.LoadTexture(DataSettings.Resourcenpfad + "Rectancle.png")
        Konsole.IniKonsole()
    End Sub
    ''' <summary>
    ''' This Sub creates the Basic Presentparameters
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function CreatePresentParameters(ByVal adap As Integer, Optional ByVal depth As Integer = 16) As PresentParameters
        Dim P As New PresentParameters

        P.Windowed = IneinemFenster 'Darstellung im Vollbild

        P.SwapEffect = SwapEffect.Discard ' SwapEffect.Flip

        P.BackBufferCount = 1

        'festlegen der Darstellungs-Parameter (present)
        P.BackBufferWidth = SCREENWIDTH

        P.BackBufferHeight = SCREENHEIGHT

        P.PresentationInterval = PresentInterval.Immediate
        '|---------------> zusaetzlich
        If IneinemFenster Then
            P.BackBufferFormat = Manager.Adapters(adap).CurrentDisplayMode().Format
        Else
            Select Case depth
                Case 16
                    P.BackBufferFormat = Format.R5G6B5
                Case Else
                    P.BackBufferFormat = Format.X8R8G8B8
            End Select
        End If


        'zusaetzlich  <---------------| 
        P.DeviceWindow = Hauptmenue.MainMenue

        P.AutoDepthStencilFormat = DepthFormat.D16
        P.EnableAutoDepthStencil = True
        Return P
    End Function
    Private Shared Sub SetPI()
        PI = Math.Atan(1) * 4
    End Sub
    ''' <summary>
    ''' Noch in Arbeit
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function LoadTexture(ByVal Pfad As String) As Texture
        If Grafikkarte IsNot Nothing Then
            Dim neueTexture As Texture

            If Not My.Computer.FileSystem.FileExists(Pfad) Then
                Konsole.Write("Couldn't find Ressource File at: " + Pfad)
                Konsole.Write("Continuing never the less")
                Return Nothing
            End If

            Dim Bild As Bitmap = Image.FromFile(Pfad)
            'Texture laden
            neueTexture = TextureLoader.FromFile(Grafikkarte, Pfad, Bild.Width, Bild.Height, 0, 0, Format.A8B8G8R8, Pool.Managed, Filter.None, Filter.None, &HFF000000)
            Return neueTexture
        Else
            Return Nothing
        End If
    End Function
    Public Shared Function LoadTexture(ByVal Bild As Bitmap)
        If Grafikkarte IsNot Nothing Then
            If Bild IsNot Nothing Then
                Dim neueTextur As Texture = Texture.FromBitmap(Grafikkarte, Bild, Usage.None, Pool.Managed)
                Return neueTextur
            End If
        Else
            Return Nothing
        End If
        Return Nothing
    End Function
    Public Shared Function LoadTexture(ByVal Bild As Image, ByVal Farbtabelle As Bitmap) As Texture
        Bild = Grafikengine.Bildveraendern(Bild, My.Resources.Neutral, 0, 0, Farbtabelle)
        Dim neueTextur As Texture = Texture.FromBitmap(Grafikkarte, Bild, Usage.None, Pool.Managed)
        Return neueTextur
    End Function
    Public Shared Function LoadTexture(ByVal Bild As Image, ByVal StartFarbtabelle As Bitmap, ByVal EndFarbtabelle As Bitmap) As Texture
        Bild = Grafikengine.Bildveraendern(Bild, StartFarbtabelle, 0, 0, EndFarbtabelle)
        Dim neueTextur As Texture = Texture.FromBitmap(Grafikkarte, Bild, Usage.None, Pool.Managed)
        Return neueTextur
    End Function
    Public Shared Function LoadTexture(ByVal Bild As Image, ByVal Hue As Single) As Texture
        Bild = Farbwertveraedern(Bild, Hue)
        Dim neueTextur As Texture = Texture.FromBitmap(Grafikkarte, Bild, Usage.None, Pool.Managed)
        Return neueTextur
    End Function
    Private Shared Function DegToRad(ByVal Degrees As Double) As Single
        DegToRad = Degrees / 180 * PI
    End Function
    Private Shared Function RadToDeg(ByVal Radians As Double) As Single
        RadToDeg = Radians * 180 / PI
    End Function

#End Region
#Region "Bildschirmaufloesung Aendern"

    ''' <summary>
    ''' Soll die Fenstergroesse geaendert werden?
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared ChangeWindowState As Boolean = False
    ''' <summary>
    ''' Malen wir gerade?
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared IsDrawing As Boolean = False
    ''' <summary>
    ''' Soll die Fenstergroesse geaendert werden?
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared ResizingDrawBreak As Boolean = False
    ''' <summary>
    ''' Bildschirm Aufloesung aendern.
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared Sub SwitchScreenMode()
        If ChangeWindowState Then
            DataSettings.Fenstermodus = Not DataSettings.Fenstermodus
            Hauptmenue.ChangeWindowMode(True)
            ChangeWindowState = False
        End If
    End Sub

#End Region
#Region "Malen"

    ''' <summary>
    ''' Hier zeichnen wir das Bild in den Backbuffer und erstellen das neue Bild auf den Bildschirm
    ''' </summary>
    Public Shared Function Updateframe() As Boolean
        'pruefen ob es den Device gibt
        If ChangeWindowState Then
            SwitchScreenMode()
        End If
        If Not ResizingDrawBreak And Not Hauptmenue.PauseFuerObjekteLaden Then

            If Grafikkarte Is Nothing Then Return False
            If DeviceLost Then
                AttemptRecovery() ' this is obvious, isn't it?
            End If
            If DeviceLost Then Return False

            IsDrawing = True
            'Update Server
            If Hauptmenue.Connection IsNot Nothing Then
                Hauptmenue.Connection.Update()
            End If
            If Hauptmenue.Lobby IsNot Nothing Then
                Hauptmenue.Lobby.Connection.Update()
                Hauptmenue.Lobby.SendLobbyUpdate()
            End If

            CreateCameraPosition()
            'Jetzt malen wir.
            CreateFrustumPlanes()

            'Bildschirm saeuber
            Grafikkarte.Clear(ClearFlags.Target Or ClearFlags.ZBuffer, System.Drawing.Color.Black, 1.0F, 0)

            'Szene beginnen
            Grafikkarte.BeginScene()

            If Konsole.KonsolenIntro Then 'Nur die Konsole anzeigen.
                Sprite.Begin(SpriteFlags.AlphaBlend)

                Konsole.Malen()

                Sprite.End()
            Else




                'wir teilen dem DirectX mit das wir nun 2D-Bilder zeichnen moechten
                Sprite.Begin(SpriteFlags.AlphaBlend)



                If Objektverwalter.Malen() = False Then
                    Return False
                End If

                Konsole.Malen()

                Sprite.End()


                If DataSettings.draw3D Then
                    If DataSettings.Lichtmaus Then
                    End If
                    Dim mat As Matrix = Matrix.Identity
                    mat.M41 = Lichtp.X
                    mat.M42 = 0
                    mat.M43 = Lichtp.Z
                    Grafikkarte.Transform.World = mat
                    'Box.DrawSubset(0)
                End If
            End If
            'Szene beenden
            Grafikkarte.EndScene()
            Try
                'Szene praesentieren
                Grafikkarte.Present()    'draw device contents to screen
            Catch e As Exception
                'AAACK! We lost the device!
                DeviceLost = True
            End Try
            IsDrawing = False
        End If
        Return True
    End Function
    ''' <summary>
    ''' Calculates the Position of our Camera
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared Sub CreateCameraPosition()
        'Am Anfang mal die Kamera ausrichten.
        If Objektverwalter.Spielfeld IsNot Nothing Then
            With Objektverwalter.Spielfeld
                Grafikkarte.Transform.Projection = Matrix.PerspectiveFovLH(Math.PI / 4, DataSettings.BildschirmBreite / DataSettings.BildschirmHoehe, 1, 1000)
                ''.KameraTarget = New Vector3(-17.125, 0, 9.9375)
                ' .Kamerahoehe= 70
                ' .KameraRichtung = 0
                ' .KameraPos = New Vector3(0, 70, -1)

                '.KameraTarget = New Vector3(-.BildschirmKooX / Hauptmenue.Feldbreite, 0, .BildschirmKooY / Hauptmenue.Feldbreite)
                ' .KameraHoehe += 1
                ' Grafikkarte.RenderState.Lighting = True
                Grafikkarte.Transform.View = Matrix.LookAtLH(.KameraPos, .KameraTarget, New Vector3(0, 1, 0))
                Grafikkarte.RenderState.FogEnable = False 'Aeh die beiden False sind glaub ich so unnoetig, aber egal, hauptsache wir haben mehr Code ;)
                ' Grafikkarte.RenderState.ZBufferEnable = False
            End With
        End If
        View = Grafikkarte.Transform.View
        Projection = Grafikkarte.Transform.Projection
    End Sub
    Public Shared Sub fillRect(ByVal Rechteck As Rectangle, ByVal intColor As Color)
        If FilledTexture Is Nothing Then Exit Sub

        Dim sngRotation As Single = 0
        Grafikengine.recBild = New Rectangle(0, 0, 1, 1)
        Grafikengine.ptfRotCenter = New Point
        Grafikengine.ptfPosition = New Drawing.Point(Rechteck.X, Rechteck.Y)
        With Grafikengine.szfScale
            .Height = Rechteck.Height
            .Width = Rechteck.Width
        End With
        Grafikengine.Sprite.Draw2D(FilledTexture, Grafikengine.recBild, Grafikengine.szfScale, Grafikengine.ptfRotCenter, sngRotation, Grafikengine.ptfPosition, intColor)
    End Sub
    Public Shared Sub fillRect(ByVal X As Integer, ByVal Y As Integer, ByVal Breite As Integer, ByVal Hoehe As Integer, ByVal intColor As Color)
        If FilledTexture Is Nothing Then Exit Sub
        Dim sngRotation As Single = 0
        Grafikengine.recBild = Nothing
        Grafikengine.ptfRotCenter = New Point
        Grafikengine.ptfPosition = New Drawing.Point(X, Y)
        With Grafikengine.szfScale
            .Height = Hoehe
            .Width = Breite
        End With
        Grafikengine.Sprite.Draw2D(FilledTexture, Grafikengine.recBild, Grafikengine.szfScale, Grafikengine.ptfRotCenter, sngRotation, Grafikengine.ptfPosition, intColor)
    End Sub
    ''' <summary>
    ''' Malt eine Box im folgendem Muster, Ecken und Rand ungezoomt, Mitte ungezoomt
    ''' </summary>
    ''' <param name="Textur"></param>
    ''' <param name="Pos"></param>
    ''' <param name="OrgSize"></param>
    ''' <param name="RandBreite"></param>
    ''' <remarks></remarks>
    ''' 
    Public Shared Sub DrawBox(ByVal Textur As Texture, ByVal Pos As Point, ByVal OrgSize As Size, ByVal RandBreite As Integer, ByVal intcolorRand As Color, ByVal intcolorMitte As Color)
        DrawBox(Textur, Pos, OrgSize, OrgSize, RandBreite, intcolorRand, intcolorMitte)
    End Sub
    ''' <summary>
    ''' Malt eine Box im folgendem Muster, Ecken und Rand ungezoomt, Mitte gezoomt
    ''' </summary>
    ''' <param name="Textur"></param>
    ''' <param name="Pos"></param>
    ''' <param name="OrgSize"></param>
    ''' <param name="DesSize"></param>
    ''' <param name="RandBreite"></param>
    ''' <remarks></remarks>
    Public Shared Sub DrawBox(ByVal Textur As Texture, ByVal Pos As Point, ByVal OrgSize As Size, ByVal DesSize As Size, ByVal RandBreite As Integer, ByVal intcolorRand As Color)
        DrawBox(Textur, Pos, OrgSize, DesSize, RandBreite, intcolorRand, intcolorRand)
    End Sub
    ''' <summary>
    ''' Malt eine Box im folgendem Muster, Ecken und Rand ungezoomt, Mitte gezoomt
    ''' </summary>
    ''' <param name="Textur"></param>
    ''' <param name="Pos"></param>
    ''' <param name="OrgSize"></param>
    ''' <param name="DesSize"></param>
    ''' <param name="RandBreite"></param>
    ''' <remarks></remarks>
    Public Shared Sub DrawBox(ByVal Textur As Texture, ByVal Pos As Point, ByVal OrgSize As Size, ByVal DesSize As Size, ByVal RandBreite As Integer, ByVal intcolorRand As Color, ByVal intcolorMitte As Color)
        If Textur IsNot Nothing Then
            Dim sngrotation As Single = 0
            Grafikengine.ptfRotCenter = New Point
            'Linke Obere Ecke
            Grafikengine.ptfPosition = Pos
            With Grafikengine.recBild
                .X = 0 : .Width = RandBreite
                .Y = 0 : .Height = RandBreite
            End With
            Grafikengine.szfScale = Nothing
            Grafikengine.Sprite.Draw2D(Textur, Grafikengine.recBild, Grafikengine.szfScale, Grafikengine.ptfRotCenter, sngrotation, Grafikengine.ptfPosition, intcolorRand)
            'Oben Mitte
            Grafikengine.ptfPosition.X += RandBreite
            With Grafikengine.recBild
                .X = RandBreite : .Width = OrgSize.Width - RandBreite * 2
                .Y = 0 : .Height = RandBreite
            End With
            Grafikengine.szfScale.Width = DesSize.Width - RandBreite * 2
            Grafikengine.szfScale.Height = RandBreite
            Grafikengine.Sprite.Draw2D(Textur, Grafikengine.recBild, Grafikengine.szfScale, Grafikengine.ptfRotCenter, sngrotation, Grafikengine.ptfPosition, intcolorRand)
            'Rechte Obere Ecke
            Grafikengine.ptfPosition.X += DesSize.Width - RandBreite * 2
            With Grafikengine.recBild
                .X = OrgSize.Width - RandBreite : .Width = RandBreite
                .Y = 0 : .Height = RandBreite
            End With
            Grafikengine.szfScale = Nothing
            Grafikengine.Sprite.Draw2D(Textur, Grafikengine.recBild, Grafikengine.szfScale, Grafikengine.ptfRotCenter, sngrotation, Grafikengine.ptfPosition, intcolorRand)
            'Links Mitte
            Grafikengine.ptfPosition.X = Pos.X
            Grafikengine.ptfPosition.Y += RandBreite
            With Grafikengine.recBild
                .X = 0 : .Width = RandBreite
                .Y = RandBreite : .Height = OrgSize.Height - 2 * RandBreite
            End With
            Grafikengine.szfScale.Height = DesSize.Height - 2 * RandBreite
            Grafikengine.szfScale.Width = RandBreite
            Grafikengine.Sprite.Draw2D(Textur, Grafikengine.recBild, Grafikengine.szfScale, Grafikengine.ptfRotCenter, sngrotation, Grafikengine.ptfPosition, intcolorRand)
            'Mitte Mitte
            Grafikengine.ptfPosition.X += RandBreite
            With Grafikengine.recBild
                .X = RandBreite : .Width = OrgSize.Width - 2 * RandBreite
                .Y = RandBreite : .Height = OrgSize.Height - 2 * RandBreite
            End With
            Grafikengine.szfScale.Width = DesSize.Width - 2 * RandBreite
            Grafikengine.Sprite.Draw2D(Textur, Grafikengine.recBild, Grafikengine.szfScale, Grafikengine.ptfRotCenter, sngrotation, Grafikengine.ptfPosition, intcolorRand)
            'Links Mitte
            Grafikengine.ptfPosition.X += DesSize.Width - RandBreite * 2
            With Grafikengine.recBild
                .X = OrgSize.Width - RandBreite : .Width = RandBreite
                .Y = RandBreite : .Height = OrgSize.Height - 2 * RandBreite
            End With
            Grafikengine.szfScale.Width = RandBreite
            Grafikengine.Sprite.Draw2D(Textur, Grafikengine.recBild, Grafikengine.szfScale, Grafikengine.ptfRotCenter, sngrotation, Grafikengine.ptfPosition, intcolorRand)
            'Linke Untere Ecke
            Grafikengine.ptfPosition.X = Pos.X
            Grafikengine.ptfPosition.Y += DesSize.Height - RandBreite * 2
            With Grafikengine.recBild
                .X = 0 : .Width = RandBreite
                .Y = OrgSize.Height - RandBreite : .Height = RandBreite
            End With
            Grafikengine.szfScale = Nothing
            Grafikengine.Sprite.Draw2D(Textur, Grafikengine.recBild, Grafikengine.szfScale, Grafikengine.ptfRotCenter, sngrotation, Grafikengine.ptfPosition, intcolorRand)
            'Unten Mitte
            Grafikengine.ptfPosition.X += RandBreite
            With Grafikengine.recBild
                .X = RandBreite : .Width = OrgSize.Width - RandBreite * 2
            End With
            Grafikengine.szfScale.Width = DesSize.Width - RandBreite * 2
            Grafikengine.szfScale.Height = RandBreite
            Grafikengine.Sprite.Draw2D(Textur, Grafikengine.recBild, Grafikengine.szfScale, Grafikengine.ptfRotCenter, sngrotation, Grafikengine.ptfPosition, intcolorRand)
            'Rechte Untere Ecke
            Grafikengine.ptfPosition.X += DesSize.Width - RandBreite * 2
            With Grafikengine.recBild
                .X = OrgSize.Width - RandBreite : .Width = RandBreite
            End With
            Grafikengine.szfScale = Nothing
            Grafikengine.Sprite.Draw2D(Textur, Grafikengine.recBild, Grafikengine.szfScale, Grafikengine.ptfRotCenter, sngrotation, Grafikengine.ptfPosition, intcolorRand)
        End If
    End Sub
    ''' <summary>
    ''' Malt eine Box auf den Bildschirm.
    ''' </summary>
    ''' <param name="Rechteck"></param>
    ''' <param name="Farbe"></param>
    ''' <param name="Rand"></param>
    ''' <remarks></remarks>
    Public Shared Sub DrawBox(ByVal Rechteck As Rectangle, ByVal Farbe As Color, ByVal Rand As Integer)
        Grafikengine.fillRect(New Rectangle(Rechteck.X, Rechteck.Y, Rechteck.Width, Rand), Farbe)
        Grafikengine.fillRect(New Rectangle(Rechteck.X, Rechteck.Y - Rand + Rechteck.Height, Rechteck.Width, Rand), Farbe)
        Grafikengine.fillRect(New Rectangle(Rechteck.X, Rechteck.Y, Rand, Rechteck.Height), Farbe)
        Grafikengine.fillRect(New Rectangle(Rechteck.X - Rand + Rechteck.Width, Rechteck.Y, Rand, Rechteck.Height), Farbe)
    End Sub
    ''' <summary>
    ''' Malt eine Textur auf den Bildschirm
    ''' </summary>
    ''' <param name="Textur"></param>
    ''' <param name="Pos"></param>
    ''' <param name="Rec"></param>
    ''' <param name="RotCenter"></param>
    ''' <param name="Rot"></param>
    ''' <param name="IntColor"></param>
    ''' <param name="Zoom"></param>
    ''' <remarks></remarks>
    Public Shared Sub Draw2D(ByVal Textur As Texture, ByVal Pos As Point, ByVal Rec As Rectangle, ByVal RotCenter As Point, ByVal Rot As Single, ByVal IntColor As Color, Optional ByVal Zoom As Single = 1.0, Optional ByVal XFlip As Boolean = False, Optional ByVal YFLip As Boolean = False)
        Grafikengine.ptfPosition = Pos
        Grafikengine.recBild = Rec

        If Rec.Width = 0 Or Rec.Height = 0 Then
            Grafikengine.szfScale = Nothing
        Else
            Grafikengine.szfScale = New Size(Rec.Width * Zoom, Rec.Height * Zoom)
        End If
        If XFlip Then Grafikengine.szfScale.Width = -Grafikengine.szfScale.Width
        If YFLip Then Grafikengine.szfScale.Height = -Grafikengine.szfScale.Height

        Grafikengine.ptfRotCenter = RotCenter
        Sprite.Draw2D(Textur, Rec, szfScale, RotCenter, Rot, Pos, IntColor)
    End Sub
    ''' <summary>
    ''' Draws a line on the Screen
    ''' </summary>
    ''' <param name="P1"></param>
    ''' <param name="P2"></param>
    ''' <param name="C"></param>
    ''' <remarks></remarks>
    Public Shared Sub DrawLine(ByVal P1 As Vector2, ByVal P2 As Vector2, ByVal C As Color, ByVal LineSize As Single, Optional ByVal AutoEndSprite As Boolean = True)
        If AutoEndSprite Then
            Grafikengine.Sprite.End()
        End If
        Dim Line As New Direct3D.Line(Grafikengine.Grafikkarte)
        Line.Width = LineSize
        Line.Draw(New Vector2() {P1, P2}, C)
        Line.Dispose()
        Line = Nothing
        If AutoEndSprite Then
            Grafikengine.Sprite.Begin(Microsoft.DirectX.Direct3D.SpriteFlags.AlphaBlend)
        End If

    End Sub
    ''' <summary>
    ''' Draws couple of Lines on the Screen
    ''' </summary>
    ''' <param name="Points"></param>
    ''' <param name="C"></param>
    ''' <remarks></remarks>
    Public Shared Sub DrawLine(ByVal Points() As Vector2, ByVal C As Color, ByVal LineSize As Single, Optional ByVal AutoEndSprite As Boolean = True)
        If Points.Length > 1 Then
            If AutoEndSprite Then
                Grafikengine.Sprite.End()
            End If
            Dim Line As New Direct3D.Line(Grafikengine.Grafikkarte)
            Line.Width = LineSize
            Line.Draw(Points, C)
            Line.Dispose()
            Line = Nothing
            If AutoEndSprite Then
                Grafikengine.Sprite.Begin(Microsoft.DirectX.Direct3D.SpriteFlags.AlphaBlend)
            End If
        End If
    End Sub
#End Region
#Region "Device wiederkriegen"

    Public Shared Sub AttemptRecovery()
        ' when we lose the device, this code will run
        Try
            Grafikkarte.TestCooperativeLevel()  'Test for Exclusive control; if it's lacking, it'll throw
            DeviceLost = False
        Catch e As DeviceLostException     'DeviceLostException. If it does, we just wait until
            'Failed.                       'our game is given the focus again.
        Catch e As DeviceNotResetException  'If we have the focus, we only need to reset the device:

            ResetDevice()
            'Catch bug As DeviceLostException  'it is possible to lose the device while resetting it.
            '    'if it got lost again or not reset, do nothing
            'End Try
        End Try
    End Sub
    Public Shared Sub ResetDevice()
        Try
            ' Basically we re-do what we did in initialize graphics
            ' Try
            'Here, you need to destroy everything in Pool_Default, and all instances of the
            ' swapchain class.
            Unload3DObjects()

            Grafikkarte.Reset(_presentParameter) 'reset the device, so we can use it again
            'Now recreate all your Pool_Default stuff, and your swapchain instances.
            Load3DObjects()

            DeviceLost = False    'device is no longer lost!!!


        Catch e2 As Exception 'You can loose the Device during recreating it.
            Konsole.Write("Lost device during recreating it: " + e2.ToString)
        End Try
    End Sub
    ''' <summary>
    ''' Unloads Unmanaged Ressources
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared Sub Unload3DObjects()
        'Sprites entlassen
        Schriftengine.MeasureSprite.Dispose()
        Sprite.Dispose()
        'Die Schrift.
        For Each F In Schriftengine.Fonts
            F.OnLostDevice()
        Next
        'Box
        Box.Dispose()
        Box = Nothing
        Grafikengine.Grafikkarte.EvictManagedResources()
    End Sub
    ''' <summary>
    ''' Load Unmanaged Ressources.
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared Sub Load3DObjects()
        'Sprites erstellen
        Sprite = New Direct3D.Sprite(Grafikkarte)
        Schriftengine.MeasureSprite = New Direct3D.Sprite(Grafikkarte)
        'Device Settings
        InitDeviceValues()
        'Font
        For Each F In Schriftengine.Fonts
            F.OnResetDevice()
        Next
        'Box
        Box = Mesh.Box(Grafikkarte, 1, 0.001, 1)

    End Sub
#End Region
#Region "Bilderveraendern"

    ''' <summary>
    ''' Diese Funktion aendert die Farbe aller Pixel mit einer 
    ''' bestimmten Farben in eine neue Farbe um
    ''' </summary>
    ''' <param name="SourceImage">Das Bild dessen Pixel neu gezeichnet werden sollen</param>
    ''' <param name="OldColor">Die alte Farbe</param>
    ''' <param name="NewColor">Die neue Farbe</param>
    Public Shared Function Pixelneueinfaerben(ByVal SourceImage As Image, ByVal OldColor As Color, ByVal NewColor As Color) As Bitmap
        Dim NewBitmap As New Bitmap(SourceImage.Width, SourceImage.Height)
        Dim CMap(0) As ColorMap

        CMap(0) = New ColorMap
        CMap(0).OldColor = OldColor
        CMap(0).NewColor = NewColor

        Dim ImgAttr As New ImageAttributes
        ImgAttr.SetRemapTable(CMap)

        Using G As Graphics = Graphics.FromImage(NewBitmap)
            G.DrawImage(SourceImage, New Rectangle(0, 0, SourceImage.Width, SourceImage.Height), 0, 0, SourceImage.Width, SourceImage.Height, GraphicsUnit.Pixel, ImgAttr)
        End Using

        Return NewBitmap
    End Function
    'Dieser Teil faerbt alles um
    ''' <summary>
    ''' Farbton eines Bitmaps aendern
    ''' </summary>
    ''' <param name="InBitmap">Bitmap-Objekt</param>
    ''' <param name="Hue">Hue (0 bis 360, 0 oder 360 = Normal)</param>
    ''' <returns>Bitmap-Objekt</returns>
    Private Shared Function Farbwertveraedern(ByVal InBitmap As Bitmap, Optional ByVal Hue As Single = 50) As Bitmap

        ' Min/Max
        If Hue < 0 Then Hue = 0
        If Hue > 360 Then Hue = 360

        Dim RedR As New Single
        Dim RedG As New Single
        Dim RedB As New Single
        Dim GreenR As New Single
        Dim GreenG As New Single
        Dim GreenB As New Single
        Dim BlueR As New Single
        Dim BlueG As New Single
        Dim BlueB As New Single
        'Sektor des Farbwertes
        Dim Sector As Integer = CInt(Hue) \ 60
        Hue = Hue / 60

        Select Case Sector

            Case 0

                RedR = 1 : GreenR = -Hue : BlueR = Hue
                RedG = Hue : GreenG = 1 : BlueG = -Hue
                RedB = -Hue : GreenB = Hue : BlueB = 1

            Case 1

                RedR = 2 - Hue : GreenR = Hue - 2 : BlueR = 1
                RedG = 1 : GreenG = 2 - Hue : BlueG = Hue - 2
                RedB = Hue - 2 : GreenB = 1 : BlueB = 2 - Hue

            Case 2

                RedR = 2 - Hue : GreenR = Hue - 2 : BlueR = 1
                RedG = 1 : GreenG = 2 - Hue : BlueG = Hue - 2
                RedB = Hue - 2 : GreenB = 1 : BlueB = 2 - Hue

            Case 3

                RedR = Hue - 4 : GreenR = 1 : BlueR = 4 - Hue
                RedG = 4 - Hue : GreenG = Hue - 4 : BlueG = 1
                RedB = 1 : GreenB = 4 - Hue : BlueB = Hue - 4

            Case 4

                RedR = Hue - 4 : GreenR = 1 : BlueR = 4 - Hue
                RedG = 4 - Hue : GreenG = Hue - 4 : BlueG = 1
                RedB = 1 : GreenB = 4 - Hue : BlueB = Hue - 4

            Case 5

                RedR = 1 : GreenR = 6 - Hue : BlueR = Hue - 6
                RedG = Hue - 6 : GreenG = 1 : BlueG = 6 - Hue
                RedB = 6 - Hue : GreenB = Hue - 6 : BlueB = 1

            Case 6

                RedR = 1 : GreenR = 0 : BlueR = 0
                RedG = 0 : GreenG = 1 : BlueG = 0
                RedB = 0 : GreenB = 0 : BlueB = 1
        End Select

        ' ColorMatrix erstellen
        Dim Matrix As New Imaging.ColorMatrix(New Single()() {New Single() {RedR, RedG, RedB, 0, 0}, New Single() {GreenR, GreenG, GreenB, 0, 0}, New Single() {BlueR, BlueG, BlueB, 0, 0}, New Single() {0, 0, 0, 1, 0}, New Single() {0, 0, 0, 0, 1}})

        ' neue Bitmap erstellen, das Bitmap das zurueckgegeben wird
        Dim NewBmp As New Bitmap(InBitmap.Width, InBitmap.Height, Drawing.Imaging.PixelFormat.Format24bppRgb)


        ' ImageAttribute-Objekt erstellen
        Using ImageAttr As New Imaging.ImageAttributes()

            ' ColorMatrix fuer das ImageAttribute-Objekt setzen
            ImageAttr.SetColorMatrix(Matrix)

            ' Graphics-Objekt von NewBmp erstellen
            Using NewBmpGra As Graphics = Graphics.FromImage(NewBmp)

                ' InBitmap in das Graphics-Objekt zeichnen
                NewBmpGra.DrawImage(InBitmap, New Rectangle(0, 0, InBitmap.Width, InBitmap.Height), 0, 0, InBitmap.Width, InBitmap.Height, GraphicsUnit.Pixel, ImageAttr)

                'Graphics-Objekt loeschen
            End Using

            ' ImageAttribute-Objekt loeschen
        End Using

        Return NewBmp

    End Function
    ''' <summary>
    ''' Helligkeit eines Bitmaps aendern
    ''' </summary>
    ''' <param name="InBitmap">Bitmap-Objekt</param>
    ''' <param name="Helligkeit">Heligkeit (-1 bis 1) 0 = Normal</param>
    ''' <returns>Bitmap-Objekt</returns>
    Public Shared Function Helligkeitveraendern(ByVal InBitmap As Bitmap, ByVal Helligkeit As Single) As Bitmap

        ' Min/Max
        If Helligkeit > 1 Then Helligkeit = 1
        If Helligkeit < -1 Then Helligkeit = -1


        ' Gammawert darf nicht = 0 sein (Bug in GDI+)
        Dim Gamma As Single = 1.0
        Dim Contrast As Single = 0.0
        ' Zur korrekten Darstellung:
        Dim Diff As Single = (Helligkeit / 2) - (Contrast / 2)

        ' ColorMatrix erstellen
        Dim Matrix As New Imaging.ColorMatrix(New Single()() {New Single() {1 + Contrast, 0, 0, 0, 0}, New Single() {0, 1 + Contrast, 0, 0, 0}, New Single() {0, 0, 1 + Contrast, 0, 0}, New Single() {0, 0, 0, 1 + Contrast, 0}, New Single() {Helligkeit + Diff, Helligkeit + Diff, Helligkeit + Diff, 0, 1}})
        'Neue Bitmap erstellen
        Dim NewBmp As New Bitmap(InBitmap.Width, InBitmap.Height, Drawing.Imaging.PixelFormat.Format24bppRgb)

        ' ImageAttribute-Objekt erstellen
        Using ImageAttr As New Imaging.ImageAttributes()

            ' ColorMatrix fuer das ImageAttribute-Objekt setzen
            ImageAttr.SetColorMatrix(Matrix)

            ' Gamma fuer das ImageAttribute-Objekt setzen
            ImageAttr.SetGamma(Gamma)

            ' Graphics-Objekt von NewBmp erstellen
            Using NewBmpGra As Graphics = Graphics.FromImage(NewBmp)

                ' InBitmap in das Graphics-Objekt zeichnen
                NewBmpGra.DrawImage(InBitmap, New Rectangle(0, 0, InBitmap.Width, InBitmap.Height), 0, 0, InBitmap.Width, InBitmap.Height, GraphicsUnit.Pixel, ImageAttr)

                'Graphics-Objekt loeschen
            End Using

            ' ImageAttribute-Objekt loeschen
        End Using

        Return NewBmp

    End Function
    'Ab hier steht eigenes Material
    ''' <summary>
    '''        Zerschneidet ein Bild in einzelne Bildteile
    ''' </summary>
    ''' <param name="Bild"></param>
    ''' <param name="AnzahlX">Die Anzahl der Bildteile in X-Richtung</param>
    ''' <param name="AnzahlY">Die Anzahl der Bildteile in Y-Richtung</param>
    ''' <returns>Gib einen Bitmap-Array zurueck wobei der Array eindimensional und in YReihen gespalten ist</returns>
    Public Function Spriteserstellen(ByVal Bild As Bitmap, ByVal AnzahlX As Integer, ByVal AnzahlY As Integer)
        Dim Bilder() As Bitmap = {}
        'Der Array wird gespalten
        Array.Resize(Bilder, AnzahlX * AnzahlY)
        Dim Bildbreite As Integer = Bild.Width
        Dim Bildhoehe As Integer = Bild.Height
        Dim einzelBildbreite As Integer = Bild.Width / AnzahlX
        Dim einzelBildhoehe As Integer = Bild.Height / AnzahlY
        'Das Bild wird einmal durch gegangen
        For I = 0 To AnzahlY - 1
            For I2 = 0 To AnzahlX - 1

                'Das einzel Bild
                Dim einzelBild As New Bitmap(einzelBildbreite, einzelBildhoehe, Drawing.Imaging.PixelFormat.Format24bppRgb)
                For I3 = 0 To einzelBildhoehe - 1
                    For I4 = 0 To einzelBildbreite - 1
                        'Hier veraendern wir den Pixel Punkt im Bitmap
                        einzelBild.SetPixel(I4, I3, Bild.GetPixel(I2 * einzelBildbreite + I4, I * einzelBildhoehe + I3))
                    Next
                Next
                Bilder(I * AnzahlX + I2) = einzelBild
            Next
        Next
        Return Bilder
    End Function
    ''' <summary>
    '''       Schneidet ein Bild aus und gibt es zurueck
    ''' </summary>
    ''' <param name="Bild"></param>
    ''' <param name="AnzahlX">Die Anzahl der Bildteile in X-Richtung angefangen bei 1</param>
    ''' <param name="AnzahlY">Die Anzahl der Bildteile in Y-Richtung angefangen bei 1</param>
    ''' <param name="BildstelleX">Das wie vielte Bild in XRichtung angefangen bei 0</param>
    ''' <param name="BildstelleY">Das wie vielte Bild in YRichtung angefangen bei 0</param>
    ''' <returns>Gibt das gewuenschte Bild zurueck</returns>
    Public Function Spriteserstellen(ByVal Bild As Bitmap, ByVal AnzahlX As Integer, ByVal AnzahlY As Integer, ByVal BildstelleX As Integer, ByVal BildstelleY As Integer)
        Dim Bildbreite As Integer = Bild.Width
        Dim Bildhoehe As Integer = Bild.Height
        Dim einzelBildbreite As Integer = Bild.Width / AnzahlX
        Dim einzelBildhoehe As Integer = Bild.Height / AnzahlY
        'Das Bild wird einmal durch gegangen
        'Das einzel Bild
        Dim einzelBild As New Bitmap(einzelBildbreite, einzelBildhoehe, Drawing.Imaging.PixelFormat.Format24bppRgb)
        For I3 = 0 To einzelBildhoehe - 1
            For I4 = 0 To einzelBildbreite - 1
                'Hier veraendern wir den Pixel Punkt im Bitmap
                einzelBild.SetPixel(I4, I3, Bild.GetPixel(BildstelleX * einzelBildbreite + I4, BildstelleY * einzelBildhoehe + I3))
            Next
        Next
        Return einzelBild
    End Function
    'Bild veraendern
    ''' <summary>
    ''' Faerbt ein Bild anhand einer Vorgegebenen Farbtabelle um
    ''' </summary>
    ''' <param name="Bild">Das Original Bild</param>
    ''' <param name="FarbtabelleimBild">Die Farbtabelle 1 Pixel Hoch beliebig Breit die Pixel muessen auch im Bild vorhanden sein</param>
    ''' <param name="Helligkeit">Um wie viel die Helligkeit veraendert werden soll [-100 bis 100] 0=Normal </param>
    ''' <param name="Farbton">Der Farbton [0 bis 360] O und 360 = Normal</param>
    ''' <param name="FarbtabellefuerdasBild">Die Farbtabelle mit der das Bild eingefaerbt hat muss nicht mit der Farbe im Bild uebereinstimmen wird anhand von Helligkeit und Farbton veraendert</param>
    ''' <returns>Gibt das veraenderte Bild als Bitmap zurueck</returns>
    Public Shared Function Bildveraendern(ByVal Bild As Bitmap, ByVal FarbtabelleimBild As Bitmap, ByVal Helligkeit As Integer, ByVal Farbton As Integer, ByVal FarbtabellefuerdasBild As Bitmap)
        'Die Farbtabelle festlegen
        Dim neueFarbtabelle As Bitmap = Grafikengine.Farbwertveraedern(FarbtabellefuerdasBild, Farbton)
        neueFarbtabelle = Grafikengine.Helligkeitveraendern(neueFarbtabelle, CSng(Helligkeit / 100))
        'So jetzt besitzen wir die Farbtabelle fuer das Bild

        'Das Bild
        Dim neueBitmap As Image = Bild
        'Die Farbtabelle wird in ein Bitmap umgeschrieben
        Dim Bitmapdateioriginal As Bitmap = FarbtabelleimBild
        Dim Bitmapdateineu As Bitmap = neueFarbtabelle

        'Die Originalen und neuen Farbvariablen
        Dim OriginalFarbwert As Color = Color.AliceBlue
        Dim NeuerFarbwert As Color = Color.AliceBlue
        'Die Farbtabelle wird einmal durchgegangen
        For I = 1 To FarbtabelleimBild.Width
            'Hier schauen wir uns das AltePixel und das neue Pixel genau an
            OriginalFarbwert = Bitmapdateioriginal.GetPixel(I - 1, 0)
            NeuerFarbwert = Bitmapdateineu.GetPixel(I - 1, 0)
            'Und jetzt schreiben wir das neue in das alte Bild rein 
            neueBitmap = Grafikengine.Pixelneueinfaerben(neueBitmap, OriginalFarbwert, NeuerFarbwert)
        Next
        Return neueBitmap
    End Function

    'So und jetzt machen wir das Bild transparent
    ''' <summary>
    ''' Macht eine bestimmte Farbe transparent
    ''' </summary>
    ''' <param name="Bild">Das Bild das transparent gemacht werden soll</param>
    ''' <param name="Farbton">Die Farbe die Transparent gemacht wird</param>
    ''' <returns>Das veraenderte Bild</returns>
    Public Function Transparent(ByVal Bild As Bitmap, ByVal Farbton As Color)
        Dim ZwischenBild As Bitmap = Bild
        ZwischenBild.MakeTransparent(Farbton)
        Bild = ZwischenBild
        Return Bild
    End Function
    'Hier Spiegeln wir ein Bild vertikal
    ''' <summary>
    ''' Spiegelt ein Bild an vertikal
    ''' </summary>
    ''' <param name="Bild">Das zu spiegelnde Bild</param>
    ''' <returns>Das gespiegelte Bild als Bitmap</returns>
    Public Function VertikalSpiegeln(ByVal Bild As Bitmap)
        Dim gespiegeltesBild As New Bitmap(Bild.Width, Bild.Height, Drawing.Imaging.PixelFormat.Format24bppRgb)
        Dim Breite As Integer = Bild.Width - 1
        For I = 0 To Bild.Width - 1
            For I2 = 0 To Bild.Height - 1
                gespiegeltesBild.SetPixel(Breite - I, I2, Bild.GetPixel(I, I2))
            Next
        Next
        Return gespiegeltesBild
    End Function
    ''' <summary>
    ''' Speichert ein Bild im angegeben Pfad
    ''' </summary>
    ''' <param name="Bild">Das zu speichernde Bild</param>
    ''' <param name="Name">Der Pfad unter dem das Spiel gespeichert wird</param>
    Public Sub Speichern(ByVal Bild As Image, ByVal Name As String)
        Bild.Save(Name + ".png", System.Drawing.Imaging.ImageFormat.Png)
    End Sub
    ''' <summary>
    ''' Diese Funktion laedt ein Bild
    ''' </summary>
    ''' <param name="Dateipfad">Der Pfad der Datei das geladen wird</param>
    ''' <returns>Das geladene Bild wird zurueckgegeben</returns>
    Public Function Laden(ByVal Dateipfad As String)
        Dim Bild As Image = System.Drawing.Image.FromFile(Dateipfad)
        Return Bild
    End Function
    ''' <summary>
    ''' Schneidet einen Teil des Bildes aus
    ''' </summary>
    ''' <param name="Xlinks">Der Linke X Wert der Ecke</param>
    ''' <param name="Yoben">Der Obere Y Wert der Ecke</param>
    ''' <param name="XRechts">Der Rechte X Wert der Ecke</param>
    ''' <param name="Yunten">Der Untere Y Wert der Ecke</param>
    ''' <param name="Bild">Das Bild wo etwas ausgeschnitten werden soll</param>
    ''' <returns>Das ausgeschnittene Bild als Bitmap</returns>
    Public Function fAusschneiden(ByVal Xlinks As Integer, ByVal Yoben As Integer, ByVal XRechts As Integer, ByVal Yunten As Integer, ByVal Bild As Bitmap)
        Dim neuesBild As New Bitmap(XRechts - Xlinks, Yunten - Yoben, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
        For I = 0 To XRechts - Xlinks - 1
            For I2 = 0 To Yunten - Yoben - 1
                neuesBild.SetPixel(I, I2, Bild.GetPixel(Xlinks + I, Yoben + I2))
            Next
        Next
        Return neuesBild
    End Function
#End Region
#Region "3D - Berechnung"

    Shared Lichtp As New Vector3
    Shared Box As Mesh
    Shared LichtKugel As Boolean = False
    Public Shared Mat As Material
    ''' <summary>
    ''' Der Vertex fuer das Hintergrundbild
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared BackgroundVertex(3) As CustomVertex.PositionTextured
    Shared Sub Lichtaendern(ByVal Lichtf As Color)
        If Not Lichtf = Lichtfarbe Then 'Kann man das bei Farben machen? Vermutlich..
            Dim R, G, B As Integer
            R = Lichtf.R / 255 * (255 - Ambientfarbe.R)
            G = Lichtf.G / 255 * (255 - Ambientfarbe.G)
            B = Lichtf.B / 255 * (255 - Ambientfarbe.B)
            'If R > 255 - Ambientfarbe.R Then R = 255 - Ambientfarbe.R
            'If G > 255 - Ambientfarbe.G Then G = 255 - Ambientfarbe.G
            'If B > 255 - Ambientfarbe.B Then B = 255 - Ambientfarbe.B
            Lichtfarbe = Color.FromArgb(255, R, G, B)
            Grafikkarte.Lights(0).Diffuse = Lichtfarbe
            Grafikkarte.Lights(0).Update()
            Grafikkarte.Lights(1).Diffuse = Lichtfarbe
            Grafikkarte.Lights(1).Update()
        End If
    End Sub
    Shared Sub LichtartAendern(ByVal Kugel As Boolean, Optional ByVal Reichweite As Single = 4)
        If Kugel Then
            Grafikkarte.Lights(0).Type = LightType.Point
            Grafikkarte.Lights(0).Range = Reichweite
            Grafikkarte.Lights(0).Attenuation0 = 0
            Grafikkarte.Lights(0).Attenuation1 = 0
            Grafikkarte.Lights(0).Attenuation2 = 0.5
            'Grafikkarte.Lights(0).Ambient = Color.White
            Mat.Emissive = Color.Black
            Mat.Ambient = Color.White
            Grafikkarte.Lights(1).Enabled = True
            Grafikkarte.Lights(1).Type = LightType.Directional
            Grafikkarte.Lights(1).Ambient = Ambientfarbe
            Grafikkarte.Lights(1).Diffuse = Color.Black
            Grafikkarte.Lights(1).Update()
            LichtKugel = True
        Else
            Grafikkarte.Lights(0).Type = LightType.Directional
            LichtKugel = False
            Mat.Emissive = Color.White
            Mat.Ambient = Color.Black
            Grafikkarte.Lights(1).Enabled = False
            Grafikkarte.Lights(1).Update()
            'Grafikkarte.Lights(0).Ambient = Color.Lime
        End If
        Grafikkarte.Lights(0).Update()
    End Sub
    Shared Sub setLichtPos(ByVal Pos As Vector3)
        If LichtKugel Then
            If Pos.X < 0 Then
                'Hmm.. ausserhalb vom Spielfeld? dann ist das licht...
                Grafikkarte.Lights(0).Position = New Vector3(0, 1000, 0)
            Else
                Grafikkarte.Lights(0).Position = Pos
            End If
            Grafikkarte.Lights(0).Update()
        End If

        ' LichtartAendern(False, 4)
    End Sub
    ''' <summary>
    ''' Erstellt die Frustum Ebenen
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared Sub CreateFrustumPlanes()
        If Grafikkarte IsNot Nothing Then
            Dim MatComb As Matrix = Matrix.Multiply(Grafikkarte.Transform.View(), Grafikkarte.Transform.Projection())
            ' Left clipping plane
            FrustumPlanes(0).X = MatComb.M14 + MatComb.M11
            FrustumPlanes(0).Y = MatComb.M24 + MatComb.M21
            FrustumPlanes(0).Z = MatComb.M34 + MatComb.M31
            FrustumPlanes(0).W = MatComb.M44 + MatComb.M41

            ' Right clipping plane
            FrustumPlanes(1).X = MatComb.M14 - MatComb.M11
            FrustumPlanes(1).Y = MatComb.M24 - MatComb.M21
            FrustumPlanes(1).Z = MatComb.M34 - MatComb.M31
            FrustumPlanes(1).W = MatComb.M44 - MatComb.M41

            ' Top clipping plane
            FrustumPlanes(2).X = MatComb.M14 - MatComb.M12
            FrustumPlanes(2).Y = MatComb.M24 - MatComb.M22
            FrustumPlanes(2).Z = MatComb.M34 - MatComb.M32
            FrustumPlanes(2).W = MatComb.M44 - MatComb.M42

            ' Bottom clipping plane
            FrustumPlanes(3).X = MatComb.M14 + MatComb.M12
            FrustumPlanes(3).Y = MatComb.M24 + MatComb.M22
            FrustumPlanes(3).Z = MatComb.M34 + MatComb.M32
            FrustumPlanes(3).W = MatComb.M44 + MatComb.M42

            ' Near clipping plane
            FrustumPlanes(4).X = MatComb.M13
            FrustumPlanes(4).Y = MatComb.M23
            FrustumPlanes(4).Z = MatComb.M33
            FrustumPlanes(4).W = MatComb.M43

            ' Far clipping plane
            FrustumPlanes(5).X = MatComb.M14 - MatComb.M13
            FrustumPlanes(5).Y = MatComb.M24 - MatComb.M23
            FrustumPlanes(5).Z = MatComb.M34 - MatComb.M33
            FrustumPlanes(5).W = MatComb.M44 - MatComb.M43

            For I = 0 To 5
                FrustumPlanes(I).Normalize()
            Next
            'BackgroundVertex erstellen
            CalculateBackgroundVertex()
        End If
        If DataSettings.HideCursor Then
            'Cursor verstecken
            Cursor.Hide()
        Else
            'Cursor zeigen
            Cursor.Show()
        End If
    End Sub
    ''' <summary>
    ''' Die Frustum Ebenen, wobei W=Distanz
    ''' 0=Linke Ebene
    ''' 1=Rechte Ebene
    ''' 2=Obere Ebene
    ''' 3=Untere Ebene
    ''' 4=Nahe Ebene vor Kamera
    ''' 5=Weite Ebene vor Kamera
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared FrustumPlanes(5) As Vector4
    ''' <summary>
    ''' Gibt an ob wir ein Objekt malen oder nicht.
    ''' </summary>
    ''' <param name="Koo"></param>
    ''' <param name="Radius"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function IsSphaereInFrustumPlane(ByVal Koo As Vector3, ByVal Radius As Single) As Boolean
        Dim Pos As New Vector4(Koo.X, Koo.Y, Koo.Z, 1.0F)
        For I = 0 To 5
            If Vector4.Dot(FrustumPlanes(I), Pos) + Radius < 0 Then
                Return False
            End If
        Next
        Return True
    End Function
    Public Shared Function IsVec3InFrustumPlane(ByVal Vec4 As Vector4) As Boolean
        If Vector4.Dot(FrustumPlanes(0), Vec4) >= FeldDistanz Then
            If Vector4.Dot(FrustumPlanes(1), Vec4) >= FeldDistanz Then
                If Vector4.Dot(FrustumPlanes(4), Vec4) >= FeldDistanz Then
                    If Vector4.Dot(FrustumPlanes(5), Vec4) >= FeldDistanz Then
                        Return True
                    End If
                End If
            End If
        End If
        Return False
    End Function

    Public Shared Sub malen2Din3D(ByVal Pos As Vector3, ByVal cube() As CustomVertex.PositionTextured, ByVal Text As Texture, ByVal Farbe As Color, Optional ByVal ImmerMalen As Boolean = False)
        If IsVec3InFrustumPlane(New Vector4(Pos.X, Pos.Y, Pos.Z, 0)) Or ImmerMalen Then
            Dim M As New Material
            M.Ambient = Farbe
            M.Diffuse = Farbe
            'M.Specular = Farbe
            Grafikkarte.Material = M
            Grafikkarte.SetTexture(0, Text)



            If Farbe.ToArgb = Color.White.ToArgb Then
                Grafikkarte.VertexFormat = CustomVertex.PositionTextured.Format
                Grafikkarte.Transform.World = Matrix.Translation(Pos)
                Grafikkarte.DrawUserPrimitives(PrimitiveType.TriangleStrip, 2, cube)
            Else
                'Grafikkarte.VertexFormat = CustomVertex.PositionTextured.Format
                'Grafikkarte.Transform.World = Matrix.Translation(Pos)
                'Grafikkarte.DrawUserPrimitives(PrimitiveType.TriangleStrip, 2, cube)
                Grafikkarte.VertexFormat = CustomVertex.PositionColoredTextured.Format
                Dim C(3) As CustomVertex.PositionColoredTextured
                Dim FarbeARGB As Integer = Farbe.ToArgb
                C(0) = New CustomVertex.PositionColoredTextured(cube(0).Position, FarbeARGB, cube(0).Tu, cube(0).Tv)
                C(1) = New CustomVertex.PositionColoredTextured(cube(1).Position, FarbeARGB, cube(1).Tu, cube(1).Tv)
                C(2) = New CustomVertex.PositionColoredTextured(cube(2).Position, FarbeARGB, cube(2).Tu, cube(2).Tv)
                C(3) = New CustomVertex.PositionColoredTextured(cube(3).Position, FarbeARGB, cube(3).Tu, cube(3).Tv)
                Grafikkarte.Transform.World = Matrix.Translation(Pos)
                Grafikkarte.DrawUserPrimitives(PrimitiveType.TriangleStrip, 2, C)
            End If

        End If
    End Sub

    Shared Function Intersect(ByVal Msh As Mesh, ByVal x As Single, ByVal y As Single, ByVal mat As Matrix) As Single
        Dim Near As Vector3
        Dim Far As Vector3
        Return Intersect(Msh, x, y, mat, Near, Far)
    End Function
    Shared Function Intersect(ByVal Msh As Mesh, ByVal x As Single, ByVal y As Single, ByVal mat As Matrix, ByRef Near As Vector3, ByRef Far As Vector3) As Single
        If Msh Is Nothing Then Return 2

        Dim Closest As IntersectInformation
        Near = New Vector3(x, y, 0)
        Far = New Vector3(x, y, 1)

        '=======================================================
        'When doing the Unproject for the 'Near' and 'Far', the 
        'last parameter should be the world transformation matrix
        'for the MESH, not the device. If you use the device's 
        'matrix it will put the mesh's position at the origin of the world
        'Try adding another mesh and moving it around to see what I mean.
        TestStrahl(x, y, Near, Far, mat)
        '=======================================================
        'Here is where you check for an intersection
        If Msh.Intersect(Near, Far, Closest) Then
            'Erwischt!
            If Closest.Dist > 1 Then
                ' Console.WriteLine("Ich dachte es geht nicht mehr als 1! War allerdings nur ne Vermutung, also doch nicht nearplane und farplane, sondern der tatsaechliche abstand in Koordinaten?")
                CInt("Hallo").ToString()
            End If
            Return Closest.Dist
        Else
            'nicht getroffen, schnaps gesoffen!
            Return 2
        End If
    End Function
    ''' <summary>
    ''' Does an Intersection for 3D
    ''' </summary>
    ''' <param name="x"></param>
    ''' <param name="y"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function Intersect(ByVal x As Single, ByVal y As Single) As Point
        'Erstmal schauen, wie die Gerade der Maus aussieht.
        Dim Near As Vector3 = New Vector3(x, y, 0) 'Pos Vector
        Dim Far As Vector3 = New Vector3(x, y, 1) 'Dir Vector
        'TestStrahl(x, y, Near, Far)

        Dim dist As Single
        Dim P As New Point(-1, -1)
        Dim distMin As Single = 2
        Dim MinPos, MinVec, pos, vec As Vector3
        For KooX = 0 To Objektverwalter.Spielfeld.Breite - 1
            For KooY = 0 To Objektverwalter.Spielfeld.Hoehe - 1
                Dim Msh As Mesh = Nothing
                Dim mat As Matrix = Matrix.Identity
                mat.M41 = KooX
                mat.M43 = -KooY

                Dim G As ObjektGebaeude = Objektverwalter.Spielfeld.Landschaften(KooX, KooY, 0).Gebaeude
                If G IsNot Nothing Then
                    'Ein Gebaeude!
                    Msh = ObjektLadeklasse.Gebaeude3D.getMesh(G.GebaeudeID)
                    dist = Intersect(Msh, x, y, mat, pos, vec)
                    If dist < distMin Then
                        'neuen Fafourit!
                        distMin = dist
                        P = New Point(KooX, KooY)
                        MinPos = pos
                        MinPos.X += mat.M41
                        MinPos.Y += mat.M42
                        MinPos.Z += mat.M43
                        MinVec = vec
                    End If
                End If

                'Dim E As ObjektEinheit = Objektverwalter.Spielfeld.Einheiten(KooX, KooY, 0)
                'If E IsNot Nothing Then
                '    'Eine Einheit!
                '    Msh = ObjektLadeklasse.Einheit3D.getMesh(E.EinheitenID)
                '    If Msh IsNot Nothing Then
                '        Dim MatE As Matrix = Matrix.RotationY(E.Rotation)
                '        Dim KooVec As Vector3 = Objektverwalter.LandschaftenBilder(Objektverwalter.Spielfeld.Landschaften(KooX, KooY, E.GetMap).ID).getFigurPos(E.getPosArt)
                '        MatE.M41 = KooX + KooVec.X
                '        MatE.M42 = KooVec.Y
                '        MatE.M43 = -KooY + KooVec.Z
                '        dist = Intersect(Msh, x, y, MatE, pos, vec)
                '        If dist < distMin Then
                '            'neuen Fafourit!
                '            distMin = dist
                '            P = New Point(KooX, KooY)
                '            MinPos = pos
                '            MinVec = vec
                '        End If
                '    End If
                'End If

                'vielleicht noch ein landschaftsmesh?
                Msh = Objektverwalter.LandschaftenBilder(Objektverwalter.Spielfeld.Landschaften(KooX, KooY, 0).ID).getMesh()
                If Msh Is Nothing Then 'bei keinem Landschaftsmesh, die box
                    Msh = Box 'wenn es kein Mesh gibt, dann halt die kleine Box, da dauert wenigstens das rechnen nicht so lange!
                    mat.M41 += 0.5
                    mat.M43 += 0.5
                End If
                dist = Intersect(Msh, x, y, mat, pos, vec)
                If dist < distMin Then
                    'neuen Fafourit!
                    distMin = dist
                    P = New Point(KooX, KooY)
                    MinPos = pos
                    MinPos.X += mat.M41
                    MinPos.Y += mat.M42
                    MinPos.Z += mat.M43
                    MinVec = vec
                End If
            Next
        Next
        If Not distMin > 1 Then
            'Ja was gefunden!
            Lichtp = Vector3.Add(MinPos, Vector3.Multiply(MinVec, -MinPos.Y / MinVec.Y))
            Lichtp = Vector3.Add(Near, Vector3.Multiply(Far, -Near.Y / Far.Y))
            Return P
        Else
            Return New Point(-1, -1)
        End If
    End Function
    ''' <summary>
    ''' Does an Intersction for 2D in 3D-Engine
    ''' </summary>
    ''' <param name="x"></param>
    ''' <param name="y"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function Intersect2D(ByVal x As Single, ByVal y As Single) As Point
        'Erstmal schauen, wie die Gerade der Maus aussieht.
        Dim Near As Vector3 = New Vector3(x, y, 0) 'Pos Vector
        Dim Far As Vector3 = New Vector3(x, y, 1) 'Dir Vector
        TestStrahl(x, y, Near, Far, Matrix.Identity)

        Dim dist As Single
        Dim P As New Point(-1, -1)
        Dim distMin As Single = -1
        Dim Cube(3) As CustomVertex.PositionNormalTextured
        Cube(0) = New CustomVertex.PositionNormalTextured(New Vector3(0, 0, 0), New Vector3, 0, 1)
        Cube(1) = New CustomVertex.PositionNormalTextured(New Vector3(0, 0, 1), New Vector3, 0, 0)
        Cube(2) = New CustomVertex.PositionNormalTextured(New Vector3(1, 0, 0), New Vector3, 1, 1)
        Cube(3) = New CustomVertex.PositionNormalTextured(New Vector3(1, 0, 1), New Vector3, 1, 0)
        For KooX = 0 To Objektverwalter.Spielfeld.Breite - 1
            For KooY = 0 To Objektverwalter.Spielfeld.Hoehe - 1
                dist = GetSchnittPunktMitCube(Cube, New Vector3(KooX, 0, -KooY), Near, Far)
                If dist >= 0 Then
                    If distMin < 0 Then
                        distMin = dist
                        P = New Point(KooX, KooY)
                    ElseIf distMin > dist Then
                        distMin = dist
                        P = New Point(KooX, KooY)
                    End If
                End If
            Next
        Next
        If distMin >= 0 Then
            Return P
        Else
            Return New Point(-1, -1)
        End If
    End Function
    ''' <summary>
    ''' Calculates the Vertex for Background drawing.
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared Sub CalculateBackgroundVertex()
        'Background Vertex erstellen
        Dim V1 As Vector3 = GetEckPunktForBackground(0, 0, Backgroundentfernung, Matrix.Identity)
        Dim V2 As Vector3 = GetEckPunktForBackground(DataSettings.BildschirmBreite, 0, Backgroundentfernung, Matrix.Identity)
        Dim V3 As Vector3 = GetEckPunktForBackground(0, DataSettings.BildschirmHoehe, Backgroundentfernung, Matrix.Identity)
        Dim V4 As Vector3 = GetEckPunktForBackground(DataSettings.BildschirmBreite, DataSettings.BildschirmHoehe, Backgroundentfernung, Matrix.Identity)

        BackgroundVertex(0) = New CustomVertex.PositionTextured(V3, 0, 1)
        BackgroundVertex(1) = New CustomVertex.PositionTextured(V1, 0, 0)
        BackgroundVertex(2) = New CustomVertex.PositionTextured(V4, 1, 1)
        BackgroundVertex(3) = New CustomVertex.PositionTextured(V2, 1, 0)
    End Sub
#Region "Project And Unproject"
    Shared View As Matrix
    Shared Projection As Matrix
    ''' <summary>
    ''' Creates the Ray for Intersection
    ''' </summary>
    ''' <param name="x"></param>
    ''' <param name="y"></param>
    ''' <param name="Pos"></param>
    ''' <param name="Dir"></param>
    ''' <remarks></remarks>
    Public Shared Sub TestStrahl(ByVal x As Single, ByVal y As Single, ByRef Pos As Vector3, ByRef Dir As Vector3, ByVal Mat As Matrix)
        Dim Near As Vector3 = New Vector3(x, y, 0) 'Pos Vector
        Dim Far As Vector3 = New Vector3(x, y, 1) 'Dir Vector
        Near.Unproject(Grafikkarte.Viewport, Grafikkarte.Transform.Projection, Grafikkarte.Transform.View, Mat)
        Far.Unproject(Grafikkarte.Viewport, Grafikkarte.Transform.Projection, Grafikkarte.Transform.View, Mat)
        Pos = Near
        Dir = Far - Near
    End Sub
    ''' <summary>
    ''' Findet heraus ob ein Cube und ein Strahl sich schneiden.
    ''' -1 ausserhalb der Kamera oder kein Schnittpunkt.
    ''' </summary>
    ''' <param name="Cube"></param>
    ''' <param name="Pos"></param>
    ''' <param name="Dir"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function GetSchnittPunktMitCube(ByVal Cube As CustomVertex.PositionNormalTextured(), ByVal CubePos As Vector3, ByVal Pos As Vector3, ByVal Dir As Vector3) As Single
        Dim V1 As Vector3 = Cube(0).Position + CubePos
        Dim V2 As Vector3 = Cube(1).Position + CubePos
        Dim V3 As Vector3 = Cube(2).Position + CubePos
        Dim V4 As Vector3 = Cube(3).Position + CubePos
        Dim NormalVector As Vector3 = Vector3.Cross(V2 - V1, V3 - V1)
        Dim R As Single = Vector3.Dot(NormalVector, V4) - NormalVector.X * Pos.X - NormalVector.Y * Pos.Y - NormalVector.Z * Pos.Z
        Dim C As Single = NormalVector.X * Dir.X + NormalVector.Y * Dir.Y + NormalVector.Z * Dir.Z
        If C <> 0 Then
            R /= C
        Else
            Return -1
        End If
        Dim EV As Vector3 = Pos + Dir * R
        If R > 0 Then
            If IsInQuadrat(V1, V2, V3, V4, NormalVector, EV) Then
                Return R
            Else
                Return -1
            End If
        Else
            Return -1
        End If
    End Function
    ''' <summary>
    ''' Ueberprueft ob ein Vector im Quadrat Liegt, wenn alle Vecktoren liegen in einer Ebene .
    ''' </summary>
    ''' <param name="PosVec"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Shared Function IsInQuadrat(ByVal V1 As Vector3, ByVal V2 As Vector3, ByVal V3 As Vector3, ByVal V4 As Vector3, ByVal NormalVector As Vector3, ByVal PosVec As Vector3) As Boolean
        Dim NVE As Vector4
        Dim EV1 As Vector3 = Vector3.Cross(V3 - V1, NormalVector)
        EV1.Normalize()
        Dim EV2 As Vector3 = Vector3.Cross(V1 - V2, NormalVector)
        EV2.Normalize()
        For I = 0 To 3
            Select Case I
                Case 0
                    NVE = New Vector4(EV1.X, EV1.Y, EV1.Z, Vector3.Dot(EV1, V1))
                Case 1
                    NVE = New Vector4(EV2.X, EV2.Y, EV2.Z, Vector3.Dot(EV2, V2))
                Case 2
                    NVE = New Vector4(-EV1.X, -EV1.Y, -EV1.Z, Vector3.Dot(-EV1, V4))
                Case Else
                    NVE = New Vector4(-EV2.X, -EV2.Y, -EV2.Z, Vector3.Dot(-EV2, V4))
            End Select
            If NVE.X * PosVec.X + NVE.Y * PosVec.Y + NVE.Z * PosVec.Z <= NVE.W Then
                Return False
            End If
        Next
        Return True
    End Function
    Public Shared Function GetSchnittPunktEbeneGerade(ByVal Ebene As Vector4, ByVal Pos As Vector3, ByVal Dir As Vector3) As Single
        Dim R As Single = Ebene.W - Ebene.X * Pos.X - Ebene.Y * Pos.Y - Ebene.Z * Pos.Z
        Dim C As Single = Ebene.X * Dir.X + Ebene.Y * Dir.Y + Ebene.Z * Dir.Z
        If C <> 0 Then
            R /= C
        Else
            Return -1
        End If
        Return R
    End Function
    ''' <summary>
    ''' Calculates the Screen Position of a 3D Point.
    ''' </summary>
    ''' <param name="worldSpacePos"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function WorldSpaceToScreenSpace(ByVal worldSpacePos As Vector3) As Point
        Dim clipSpacePos As Vector4
        'If DuringDrawing Then
        clipSpacePos = Vector4.Transform(New Vector4(worldSpacePos.X, worldSpacePos.Y, worldSpacePos.Z, 1.0F), Matrix.Multiply(View, Projection))
        'Else
        '    clipSpacePos = Vector4.Transform(New Vector4(worldSpacePos.X, worldSpacePos.Y, worldSpacePos.Z, 1.0F), Matrix.Multiply(Grafikkarte.Transform.View, Grafikkarte.Transform.Projection))
        'End If
        Dim screenSpacePos As Vector2
        screenSpacePos.X = (clipSpacePos.X / clipSpacePos.W) * 0.5F + 0.5F
        screenSpacePos.Y = 1.0F - ((clipSpacePos.Y / clipSpacePos.W) * 0.5F + 0.5F)
        screenSpacePos.X *= Grafikkarte.Viewport.Width
        screenSpacePos.Y *= Grafikkarte.Viewport.Height
        Return New Point(screenSpacePos.X, screenSpacePos.Y)
    End Function

    ''' <summary>
    ''' 
    ''' </summary>
    ''' <param name="x"></param>
    ''' <param name="y"></param>
    ''' <remarks></remarks>
    Public Shared Function GetEckPunktForBackground(ByVal x As Single, ByVal y As Single, ByVal Z As Single, ByVal Mat As Matrix) As Vector3
        Dim V As New Vector3(x, y, Z) 'Pos Vector
        V.Unproject(Grafikkarte.Viewport, Grafikkarte.Transform.Projection, Grafikkarte.Transform.View, Matrix.Identity)
        Return V
    End Function
#End Region
#End Region
End Class